home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / timeit.bas < prev    next >
BASIC Source File  |  1997-06-14  |  56KB  |  2,040 lines
  1. Attribute VB_Name = "MTimeIt"
  2. Option Explicit
  3.  
  4. '$ Uses DEBUG.BAS UTILITY.BAS SORT.BAS
  5.  
  6. Private Declare Function GetVersionTmp Lib "kernel32" Alias "GetVersion" () As Long
  7.  
  8. #If fUseCpp Then
  9. Private Declare Function LoWord5 Lib "vbutil32" Alias "LoWord" (ByVal dw As Long) As Integer
  10. Private Declare Function HiWord5 Lib "vbutil32" Alias "HiWord" (ByVal dw As Long) As Integer
  11. #End If
  12.  
  13. Private n As Long
  14. Private iVar As Integer
  15.  
  16. Private Type TLoHiLong
  17.     lo As Integer
  18.     hi As Integer
  19. End Type
  20.  
  21. Private Type TAllLong
  22.     all As Long
  23. End Type
  24.  
  25. Function LogicalAndVsNestedIf(cIter As Long) As String
  26.     Dim sec As Currency, secOut As Currency
  27.     Dim sMsg As String, i As Integer, iIter As Long
  28.  
  29.     i = 21
  30.     ProfileStart sec
  31.     For iIter = 1 To cIter
  32.         If i <= 20 And i >= 10 Then i = i + 1
  33.     Next
  34.     ProfileStop sec, secOut
  35.     sMsg = sMsg & "If a And b Then: " & secOut & " sec" & sCrLf
  36.     
  37.     i = 21
  38.     ProfileStart sec
  39.     For iIter = 1 To cIter
  40.         If i <= 20 Then If i >= 10 Then i = i + 1
  41.     Next
  42.     ProfileStop sec, secOut
  43.     sMsg = sMsg & "If a Then If b Then: " & secOut & " sec" & sCrLf
  44.  
  45.     LogicalAndVsNestedIf = sMsg
  46.  
  47. End Function
  48.  
  49. Function ByValVsByRef(cIter As Long) As String
  50.     Dim sec As Currency, secOut As Currency
  51.     Dim sMsg As String, n As Long
  52.     Dim i As Integer, lng As Long, sng As Single, dbl As Double
  53.     Dim v As Variant, s As String
  54.     
  55.     i = 5
  56.     ProfileStart sec
  57.     For n = 1 To cIter
  58.         TestByValInt i
  59.     Next
  60.     ProfileStop sec, secOut
  61.     sMsg = sMsg & "Integer by value: " & secOut & " sec" & sCrLf
  62.  
  63.     ProfileStart sec
  64.     For n = 1 To cIter
  65.         TestByRefInt i
  66.     Next
  67.     ProfileStop sec, secOut
  68.     sMsg = sMsg & "Integer by reference: " & secOut & " sec" & sCrLf
  69.  
  70.     lng = 100000
  71.     ProfileStart sec
  72.     For n = 1 To cIter
  73.         TestByValLong lng
  74.     Next
  75.     ProfileStop sec, secOut
  76.     sMsg = sMsg & "Long by value: " & secOut & " sec" & sCrLf
  77.  
  78.     ProfileStart sec
  79.     For n = 1 To cIter
  80.         TestByRefLong lng
  81.     Next
  82.     ProfileStop sec, secOut
  83.     sMsg = sMsg & "Long by reference: " & secOut & " sec" & sCrLf
  84.     
  85.     sng = 2.1
  86.     ProfileStart sec
  87.     For n = 1 To cIter
  88.         TestByValSng sng
  89.     Next
  90.     ProfileStop sec, secOut
  91.     sMsg = sMsg & "Single by value: " & secOut & " sec" & sCrLf
  92.  
  93.     ProfileStart sec
  94.     For n = 1 To cIter
  95.         TestByRefSng sng
  96.     Next
  97.     ProfileStop sec, secOut
  98.     sMsg = sMsg & "Single by reference: " & secOut & " sec" & sCrLf
  99.  
  100.     dbl = 2.1
  101.     ProfileStart sec
  102.     For n = 1 To cIter
  103.         TestByValDbl dbl
  104.     Next
  105.     ProfileStop sec, secOut
  106.     sMsg = sMsg & "Double by value: " & secOut & " sec" & sCrLf
  107.  
  108.     ProfileStart sec
  109.     For n = 1 To cIter
  110.         TestByRefDbl dbl
  111.     Next
  112.     ProfileStop sec, secOut
  113.     sMsg = sMsg & "Double by reference: " & secOut & " sec" & sCrLf
  114.  
  115.     v = CDbl(2.1)
  116.     ProfileStart sec
  117.     For n = 1 To cIter
  118.         TestByValVar v
  119.     Next
  120.     ProfileStop sec, secOut
  121.     sMsg = sMsg & "Variant (Double) by value: " & secOut & " sec" & sCrLf
  122.  
  123.     ProfileStart sec
  124.     For n = 1 To cIter
  125.         TestByRefVar v
  126.     Next
  127.     ProfileStop sec, secOut
  128.     sMsg = sMsg & "Variant (Double) by reference: " & secOut & " sec" & sCrLf
  129.  
  130.     s = "Hardcore"
  131.     ProfileStart sec
  132.     For n = 1 To cIter
  133.         TestByValStr s
  134.     Next
  135.     ProfileStop sec, secOut
  136.     sMsg = sMsg & "String by value: " & secOut & " sec" & sCrLf
  137.  
  138.     ProfileStart sec
  139.     For n = 1 To cIter
  140.         TestByRefStr s
  141.     Next
  142.     ProfileStop sec, secOut
  143.     sMsg = sMsg & "String by reference: " & secOut & " sec" & sCrLf
  144.  
  145.     ByValVsByRef = sMsg
  146.  
  147. End Function
  148.  
  149. Private Sub TestByValInt(ByVal iArg As Integer)
  150.     Dim iVar As Integer
  151.     iVar = iArg
  152. End Sub
  153.  
  154. Private Sub TestByRefInt(ByRef iArg As Integer)
  155.     Dim iVar As Integer
  156.     iVar = iArg
  157. End Sub
  158.  
  159. Private Sub TestByValLong(ByVal iArg As Long)
  160.     Dim iVar As Long
  161.     iVar = iArg
  162. End Sub
  163.  
  164. Private Sub TestByRefLong(ByRef iArg As Long)
  165.     Dim iVar As Long
  166.     iVar = iArg
  167. End Sub
  168.  
  169. Private Sub TestByValSng(ByVal rArg As Single)
  170.     Dim rVar As Single
  171.     rVar = rArg
  172. End Sub
  173.  
  174. Private Sub TestByRefSng(ByRef rArg As Single)
  175.     Dim rVar As Single
  176.     rVar = rArg
  177. End Sub
  178.  
  179. Private Sub TestByValDbl(ByVal rArg As Double)
  180.     Dim rVar As Double
  181.     rVar = rArg
  182. End Sub
  183.  
  184. Private Sub TestByRefDbl(ByRef rArg As Double)
  185.     Dim rVar As Double
  186.     rVar = rArg
  187. End Sub
  188.  
  189. Private Sub TestByValCy(ByVal cyArg As Currency)
  190.     Dim cyVar As Currency
  191.     cyVar = cyArg
  192. End Sub
  193.  
  194. Private Sub TestByRefCy(ByRef cyArg As Currency)
  195.     Dim cyVar As Currency
  196.     cyVar = cyArg
  197. End Sub
  198.  
  199. Private Sub TestByValVar(ByVal vArg As Variant)
  200.     Dim vVar As Variant
  201.     vVar = vArg
  202. End Sub
  203.  
  204. Private Sub TestByRefVar(ByRef vArg As Variant)
  205.     Dim vVar As Variant
  206.     vVar = vArg
  207. End Sub
  208.  
  209. Private Sub TestByValStr(ByVal sArg As String)
  210.     Dim sVar As String
  211.     sVar = sArg
  212. End Sub
  213.  
  214. Private Sub TestByRefStr(ByRef sArg As String)
  215.     Dim sVar As String
  216.     sVar = sArg
  217. End Sub
  218.  
  219. Function CompareTypeProcessing(cIter As Long) As String
  220.     Dim sec As Currency, secOut As Currency
  221.     Dim sMsg As String
  222.     Dim i As Integer, v As Variant, l As Long
  223.     Dim s As Single, d As Double, c As Currency
  224.     Dim i2 As Integer, v2 As Variant, l2 As Long
  225.     Dim s2 As Single, d2 As Double, c2 As Currency
  226.     Dim ci As Integer, cv As Variant, cl As Long
  227.     Dim cs As Single, cd As Double, cc As Currency
  228.     ci = IIf(cIter < 32767&, cIter, 0)
  229.     cv = cIter: cl = cIter: cs = cIter: cd = cIter: cc = cIter
  230.     
  231.     ProfileStart sec
  232.     i = 1
  233.     Do While i < ci
  234.         i2 = 1
  235.         Do While i2 < ci
  236.             i2 = i2 + 1
  237.         Loop
  238.         i = i + 1
  239.     Loop
  240.     ProfileStop sec, secOut
  241.     sMsg = "Integer: " & secOut & " sec" & sCrLf
  242.  
  243.     ProfileStart sec
  244.     l = 1
  245.     Do While l < cl
  246.         l2 = 1
  247.         Do While l2 < ci
  248.             l2 = l2 + 1
  249.         Loop
  250.         l = l + 1
  251.     Loop
  252.     ProfileStop sec, secOut
  253.     sMsg = sMsg & "Long: " & secOut & " sec" & sCrLf
  254.  
  255.     ProfileStart sec
  256.     s = 1
  257.     Do While s < cs
  258.         s2 = 1
  259.         Do While s2 < ci
  260.             s2 = s2 + 1
  261.         Loop
  262.         s = s + 1
  263.     Loop
  264.     ProfileStop sec, secOut
  265.     sMsg = sMsg & "Single: " & secOut & " sec" & sCrLf
  266.  
  267.     ProfileStart sec
  268.     d = 1
  269.     Do While d < cd
  270.         d2 = 1
  271.         Do While d2 < ci
  272.             d2 = d2 + 1
  273.         Loop
  274.         d = d + 1
  275.     Loop
  276.     ProfileStop sec, secOut
  277.     sMsg = sMsg & "Double: " & secOut & " sec" & sCrLf
  278.  
  279.     ProfileStart sec
  280.     c = 1
  281.     Do While c < cc
  282.         c2 = 1
  283.         Do While c2 < ci
  284.             c2 = c2 + 1
  285.         Loop
  286.         c = c + 1
  287.     Loop
  288.     ProfileStop sec, secOut
  289.     sMsg = sMsg & "Currency: " & secOut & " sec" & sCrLf
  290.  
  291.     ProfileStart sec
  292.     v = 1
  293.     Do While v < cv
  294.         v2 = 1
  295.         Do While v2 < ci
  296.             v2 = v2 + 1
  297.         Loop
  298.         v = v + 1
  299.     Loop
  300.     ProfileStop sec, secOut
  301.     sMsg = sMsg & "Variant: " & secOut & " sec" & sCrLf
  302.  
  303.     CompareTypeProcessing = sMsg
  304.  
  305. End Function
  306.  
  307. Function InlineVsFunction(cIter As Long) As String
  308.     Dim sec As Currency, secOut As Currency
  309.     Dim sMsg As String
  310.     Dim i As Long, n As Long, d As Double
  311.  
  312.     i = 1
  313.     ProfileStart sec
  314.     
  315.     For n = 1 To cIter
  316.         i = i + 1
  317.     Next
  318.  
  319.     ProfileStop sec, secOut
  320.     sMsg = "Inline addition: " & secOut & " sec" & sCrLf
  321.  
  322.     i = 1
  323.     ProfileStart sec
  324.     For n = 1 To cIter
  325.         i = AddEm(i, 5)
  326.     Next
  327.  
  328.     ProfileStop sec, secOut
  329.     sMsg = sMsg & "Function Addition: " & secOut & " sec" & sCrLf
  330.  
  331.     i = 1
  332.     ProfileStart sec
  333.     For n = 1 To cIter
  334.         d = n ^ 5
  335.     Next
  336.  
  337.     ProfileStop sec, secOut
  338.     sMsg = sMsg & "Inline power: " & secOut & " sec" & sCrLf
  339.  
  340.     i = 1
  341.     ProfileStart sec
  342.     For n = 1 To cIter
  343.         d = Power(n, 5)
  344.     Next
  345.  
  346.     ProfileStop sec, secOut
  347.     sMsg = sMsg & "Function power: " & secOut & " sec" & sCrLf
  348.  
  349.     InlineVsFunction = sMsg
  350.                                     
  351. End Function
  352.  
  353. Function FixedVsVariableString(cIter As Long) As String
  354.     Dim sec As Currency, secOut As Currency
  355.     Dim sMsg As String
  356.     Dim c As Long, n As Long, s As String
  357.     Dim sVariable As String
  358.     Dim sFixed As String * 8
  359.     sVariable = "Hardcore"
  360.     sFixed = "Hardcore"
  361.  
  362.     ProfileStart sec
  363.     For n = 1 To cIter
  364.         sVariable = "Hardcore"
  365.     Next
  366.     ProfileStop sec, secOut
  367.     sMsg = sMsg & "Assign to variable-length string: " & secOut & " sec" & sCrLf
  368.  
  369.     ProfileStart sec
  370.     For n = 1 To cIter
  371.         sFixed = "Hardcore"
  372.     Next
  373.     ProfileStop sec, secOut
  374.     sMsg = sMsg & "Assign to fixed-length string: " & secOut & " sec" & sCrLf
  375.     
  376.     ProfileStart sec
  377.     For n = 1 To cIter
  378.         s = Mid$(sVariable, 3, 2)
  379.     Next
  380.     ProfileStop sec, secOut
  381.     sMsg = sMsg & "Pass variable-length string to Mid$: " & secOut & " sec" & sCrLf
  382.  
  383.     ProfileStart sec
  384.     For n = 1 To cIter
  385.         s = Mid$(sFixed, 3, 2)
  386.     Next
  387.     ProfileStop sec, secOut
  388.     sMsg = sMsg & "Pass fixed-length string to Mid$: " & secOut & " sec" & sCrLf
  389.  
  390.     ProfileStart sec
  391.     For n = 1 To cIter / 100
  392.         s = s & sVariable
  393.     Next
  394.     ProfileStop sec, secOut
  395.     sMsg = sMsg & "Concatenate variable-length string: " & secOut & " sec" & sCrLf
  396.  
  397.     ProfileStart sec
  398.     For n = 1 To cIter / 100
  399.         s = s & sFixed
  400.     Next
  401.     ProfileStop sec, secOut
  402.     sMsg = sMsg & "Concatenate fixed-length string: " & secOut & " sec" & sCrLf
  403.     
  404.     sVariable = "Time It"
  405.     ProfileStart sec
  406.     For n = 1 To cIter / 10
  407.         c = FindWindow(sNullStr, sVariable)
  408.     Next
  409.     ProfileStop sec, secOut
  410.     BugMessage "Window handle: " & Hex(c)
  411.     sMsg = sMsg & "Pass variable-length string to API: " & secOut & " sec" & sCrLf
  412.  
  413.     Dim sFixed2 As String * 7
  414.     sFixed = "Time It"
  415.     ProfileStart sec
  416.     For n = 1 To cIter / 10
  417.         c = FindWindow(sNullStr, sFixed2)
  418.     Next
  419.     ProfileStop sec, secOut
  420.     BugMessage "Window handle: " & Hex(c)
  421.     sMsg = sMsg & "Pass fixed-length string to API: " & secOut & " sec" & sCrLf
  422.  
  423.     Dim sVariableBuf As String
  424.     sVariableBuf = String(80, 0)
  425.     ProfileStart sec
  426.     For n = 1 To cIter / 10
  427.         c = GetWindowText(FTimeIt.hWnd, sVariableBuf, 80)
  428.     Next
  429.     ProfileStop sec, secOut
  430.     s = Left$(sVariableBuf, c)
  431.     BugMessage "Window Text: " & s
  432.     sMsg = sMsg & "Use variable-length string as API buffer: " & secOut & " sec" & sCrLf
  433.  
  434.     Dim sFixedBuf As String * 80
  435.     ProfileStart sec
  436.     For n = 1 To cIter / 10
  437.         c = GetWindowText(FTimeIt.hWnd, sFixedBuf, 80)
  438.     Next
  439.     ProfileStop sec, secOut
  440.     BugMessage "Window Text: " & s
  441.     s = Left$(sFixedBuf, c)
  442.     sMsg = sMsg & "Use fixed-length string as API buffer: " & secOut & " sec" & sCrLf
  443.  
  444.     FixedVsVariableString = sMsg
  445.                                     
  446. End Function
  447.  
  448. Private Function AddEm(ByVal i1 As Long, i2 As Long) As Long
  449.     AddEm = i1 + i2
  450. End Function
  451.  
  452. Private Function Power(ByVal i1 As Long, i2 As Long) As Double
  453.     Power = i1 ^ i2
  454. End Function
  455.  
  456. Function CompareLoWords(cIter As Long) As String
  457.     Dim sec As Currency, secOut As Currency
  458.     Dim sMsg As String
  459.     Dim i As Long
  460.     Dim f16Wrap As Integer, f16NoWrap As Integer
  461.     Dim f32Wrap As Long, f32NoWrap As Long
  462.     f32NoWrap = &H12345678
  463.     f32Wrap = &HFEDCBA98
  464.     BugMessage "Wrap: " & Hex$(f32Wrap) & "  NoWrap: " & Hex$(f32NoWrap)
  465.     
  466.     ProfileStart sec
  467.     For i = 1 To cIter
  468.         f16NoWrap = LoWord1(f32NoWrap)
  469.     Next
  470.     ProfileStop sec, secOut
  471.     sMsg = sMsg & "LoWord1 - AND positive: " & secOut & " sec" & sCrLf
  472.  
  473. #If 0 Then
  474.     ' This causes overflow!
  475.     ProfileStart sec
  476.     For i = 1 To cIter
  477.         f16Wrap = LoWord1(f32Wrap)
  478.     Next
  479.     ProfileStop sec, secOut
  480.     sMsg = "LoWord1 - AND negative: " & secOut & " sec" & sCrLf
  481.     BugMessage "LoWord1 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  482. #End If
  483.     sMsg = sMsg & "LoWord1 - AND negative: Overflow" & sCrLf
  484.     BugMessage "LoWord1 Wrap: " & "FAIL" & "  NoWrap: " & Hex$(f16NoWrap)
  485.  
  486.     ProfileStart sec
  487.     For i = 1 To cIter
  488.         f16NoWrap = LoWord2(f32NoWrap)
  489.     Next
  490.     ProfileStop sec, secOut
  491.     sMsg = sMsg & "LoWord2 - AND positive after sign check: " & secOut & " sec" & sCrLf
  492.  
  493.     ProfileStart sec
  494.     For i = 1 To cIter
  495.         f16Wrap = LoWord2(f32Wrap)
  496.     Next
  497.     ProfileStop sec, secOut
  498.     sMsg = sMsg & "LoWord2 - OR negative after sign check: " & secOut & " sec" & sCrLf
  499.     BugMessage "LoWord2 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  500.  
  501.     f16Wrap = LoWord3(f32Wrap)
  502.     ProfileStart sec
  503.     For i = 1 To cIter
  504.         f16NoWrap = LoWord3(f32NoWrap)
  505.     Next
  506.     ProfileStop sec, secOut
  507.     sMsg = sMsg & "LoWord3 - Copy low word with LSet: " & secOut & " sec" & sCrLf
  508.     BugMessage "LoWord3 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  509.  
  510.     f16Wrap = LoWord4(f32Wrap)
  511.     ProfileStart sec
  512.     For i = 1 To cIter
  513.         f16NoWrap = LoWord4(f32NoWrap)
  514.     Next
  515.     ProfileStop sec, secOut
  516.     sMsg = sMsg & "LoWord4 - Copy low word with CopyMemory: " & secOut & " sec" & sCrLf
  517.     BugMessage "LoWord4 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  518.     
  519. #If fUseCpp Then
  520.     f16Wrap = LoWord5(f32Wrap)
  521.     ProfileStart sec
  522.     For i = 1 To cIter
  523.         f16NoWrap = LoWord5(f32NoWrap)
  524.     Next
  525.     ProfileStop sec, secOut
  526.     sMsg = sMsg & "LoWord5 - AND low word in C++: " & secOut & " sec" & sCrLf
  527.     BugMessage "LoWord5 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  528. #End If
  529.  
  530.     ProfileStart sec
  531.     For i = 1 To cIter
  532.         f16NoWrap = HiWord1(f32NoWrap)
  533.     Next
  534.     ProfileStop sec, secOut
  535.     sMsg = sMsg & "HiWord1 - AND negative: " & secOut & " sec" & sCrLf
  536.  
  537.     ProfileStart sec
  538.     For i = 1 To cIter
  539.         f16Wrap = HiWord1(f32Wrap)
  540.     Next
  541.     ProfileStop sec, secOut
  542.     sMsg = sMsg & "HiWord1 - AND positive: " & secOut & " sec" & sCrLf
  543.     BugMessage "HiWord1 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  544.  
  545. #If 0 Then
  546.     ProfileStart sec
  547.     For i = 1 To cIter
  548.         f16NoWrap = HiWord2(f32NoWrap)
  549.     Next
  550.     ProfileStop sec, secOut
  551.     sMsg = sMsg & "HiWord2 - AND positive after sign check: " & secOut & " sec" & sCrLf
  552.  
  553.     ProfileStart sec
  554.     For i = 1 To cIter
  555.         f16Wrap = HiWord2(f32Wrap)
  556.     Next
  557.     ProfileStop sec, secOut
  558.     sMsg = sMsg & "HiWord2 - AND negative after sign check: " & secOut & " sec" & sCrLf
  559.     BugMessage "HiWord2 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  560. #End If
  561.  
  562.     f16Wrap = HiWord3(f32Wrap)
  563.     ProfileStart sec
  564.     For i = 1 To cIter
  565.         f16NoWrap = HiWord3(f32NoWrap)
  566.     Next
  567.     ProfileStop sec, secOut
  568.     sMsg = sMsg & "HiWord3 - Copy high word with LSet: " & secOut & " sec" & sCrLf
  569.     BugMessage "HiWord3 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  570.  
  571.     f16Wrap = HiWord4(f32Wrap)
  572.     ProfileStart sec
  573.     For i = 1 To cIter
  574.         f16NoWrap = HiWord4(f32NoWrap)
  575.     Next
  576.     ProfileStop sec, secOut
  577.     sMsg = sMsg & "HiWord4 - Copy high word with CopyMemory: " & secOut & " sec" & sCrLf
  578.     BugMessage "HiWord4 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  579.     
  580. #If fUseCpp Then
  581.     f16Wrap = HiWord5(f32Wrap)
  582.     ProfileStart sec
  583.     For i = 1 To cIter
  584.         f16NoWrap = HiWord5(f32NoWrap)
  585.     Next
  586.     ProfileStop sec, secOut
  587.     sMsg = sMsg & "HiWord5 - AND high word in C++: " & secOut & " sec" & sCrLf
  588.     BugMessage "HiWord5 Wrap: " & Hex$(f16Wrap) & "  NoWrap: " & Hex$(f16NoWrap)
  589. #End If
  590.  
  591.     CompareLoWords = sMsg
  592.  
  593. End Function
  594.  
  595. Function LoWord1(ByVal dw As Long) As Integer
  596.     LoWord1 = dw And &HFFFF&
  597. End Function
  598.  
  599. Function LoWord2(ByVal dw As Long) As Integer
  600.     If dw And &H8000& Then
  601.         LoWord2 = dw Or &HFFFF0000
  602.     Else
  603.         LoWord2 = dw And &HFFFF&
  604.     End If
  605. End Function
  606.  
  607. Function LoWord3(ByVal dw As Long) As Integer
  608.     Dim lohi As TLoHiLong
  609.     Dim all  As TAllLong
  610.     all.all = dw
  611.     LSet lohi = all
  612.     LoWord3 = lohi.lo
  613. End Function
  614.  
  615. Function LoWord4(ByVal dw As Long) As Integer
  616.     Dim w As Integer
  617.     CopyMemory w, dw, 2
  618.     LoWord4 = w
  619.     'CopyMemory LoWord4, dw, 2
  620. End Function
  621.  
  622. Function HiWord1(ByVal dw As Long) As Integer
  623.     HiWord1 = (dw And &HFFFF0000) \ 65536
  624. End Function
  625.  
  626. Function HiWord2(ByVal dw As Long) As Integer
  627.     HiWord2 = (dw And &HFFFF0000) \ 65536
  628. End Function
  629.  
  630. Function HiWord3(ByVal dw As Long) As Integer
  631.     Dim lohi As TLoHiLong
  632.     Dim all  As TAllLong
  633.     all.all = dw
  634.     LSet lohi = all
  635.     HiWord3 = lohi.hi
  636. End Function
  637.  
  638. Function HiWord4(ByVal dw As Long) As Integer
  639.     CopyMemory HiWord4, ByVal VarPtr(dw) + 2, 2
  640. End Function
  641.  
  642. Function LShiftWordB(ByVal w As Integer, ByVal c As Integer) As Integer
  643.     Dim dw As Long
  644.     dw = w * (2 ^ c)
  645.     If dw And &H8000& Then
  646.         LShiftWordB = CInt(dw And &H7FFF&) Or &H8000
  647.     Else
  648.         LShiftWordB = dw And &HFFFF&
  649.     End If
  650. End Function
  651.  
  652. Function RShiftWordB(ByVal w As Integer, ByVal c As Integer) As Integer
  653.     Dim dw As Long
  654.     If c = 0 Then
  655.         RShiftWordB = w
  656.     Else
  657.         dw = w And &HFFFF&
  658.         dw = dw \ (2 ^ c)
  659.         RShiftWordB = dw And &HFFFF&
  660.     End If
  661. End Function
  662.  
  663. Function IIfVsIfThen(cIter As Long) As String
  664.     Dim sec As Currency, secOut As Currency
  665.     Dim sMsg As String
  666.     Dim i As Long, iRes As Integer
  667.     Dim ix As Integer, iy As Integer
  668.     ix = 40: iy = 50
  669.     
  670.     ProfileStart sec
  671.     For i = 1 To cIter
  672.         iRes = IIf(ix > iy, ix, iy)
  673.     Next
  674.     ProfileStop sec, secOut
  675.     sMsg = sMsg & "IIf: " & secOut & " sec" & sCrLf
  676.  
  677.     ProfileStart sec
  678.     For i = 1 To cIter
  679.         If ix > iy Then
  680.             iRes = ix
  681.         Else
  682.             iRes = iy
  683.         End If
  684.     Next
  685.     ProfileStop sec, secOut
  686.     sMsg = sMsg & "If-Then-Else: " & secOut & " sec" & sCrLf
  687.  
  688.     ProfileStart sec
  689.     For i = 1 To cIter
  690.         iRes = MyIIf(ix > iy, ix, iy)
  691.     Next
  692.     ProfileStop sec, secOut
  693.     sMsg = sMsg & "MyIIf (Variant): " & secOut & " sec" & sCrLf
  694.  
  695.     ProfileStart sec
  696.     For i = 1 To cIter
  697.         iRes = MyIIfInt(ix > iy, ix, iy)
  698.     Next
  699.     ProfileStop sec, secOut
  700.     sMsg = sMsg & "MyIIfInt: " & secOut & " sec" & sCrLf
  701.  
  702.     IIfVsIfThen = sMsg
  703.  
  704. End Function
  705.  
  706. Private Function MyIIf(vCondition As Variant, vTrue As Variant, vFalse As Variant) As Variant
  707.     If vCondition Then
  708.         MyIIf = vTrue
  709.     Else
  710.         MyIIf = vFalse
  711.     End If
  712. End Function
  713.  
  714. Private Function MyIIfInt(iCondition As Integer, iTrue As Integer, iFalse As Integer) As Integer
  715.     If iCondition Then
  716.         MyIIfInt = iTrue
  717.     Else
  718.         MyIIfInt = iFalse
  719.     End If
  720. End Function
  721.  
  722. Function DollarVsNone(cIter As Long) As String
  723.     Dim sec As Currency, secOut As Currency
  724.     Dim sMsg As String
  725.     Dim i As Long, iPos As Integer, cInput As Integer
  726.     Const sTest As String = "To VB or not to VB, that is the question..."
  727.     cInput = Len(sTest)
  728.     Dim sOut As String, vOut As Variant
  729.     Dim sInput As String, vInput As Variant
  730.  
  731.     sInput = sTest
  732.     ProfileStart sec
  733.     For i = 1 To cIter
  734.         For iPos = 1 To Len(sInput) - 1
  735.             sOut = Mid$(sInput, iPos)
  736.         Next
  737.     Next
  738.     ProfileStop sec, secOut
  739.     sMsg = sMsg & "s = Mid$(s, i): " & secOut & " sec" & sCrLf
  740.  
  741.     vInput = sTest
  742.     ProfileStart sec
  743.     For i = 1 To cIter
  744.         For iPos = 1 To Len(sInput) - 1
  745.             sOut = Mid$(vInput, iPos)
  746.         Next
  747.     Next
  748.     ProfileStop sec, secOut
  749.     sMsg = sMsg & "s = Mid$(v, i): " & secOut & " sec" & sCrLf
  750.  
  751.     vInput = sTest
  752.     ProfileStart sec
  753.     For i = 1 To cIter
  754.         For iPos = 1 To Len(sInput) - 1
  755.             vOut = Mid$(vInput, iPos)
  756.         Next
  757.     Next
  758.     ProfileStop sec, secOut
  759.     sMsg = sMsg & "v = Mid$(v, i): " & secOut & " sec" & sCrLf
  760.     
  761.     sInput = sTest
  762.     ProfileStart sec
  763.     For i = 1 To cIter
  764.         For iPos = 1 To Len(sInput) - 1
  765.             vOut = Mid$(sInput, iPos)
  766.         Next
  767.     Next
  768.     ProfileStop sec, secOut
  769.     sMsg = sMsg & "v = Mid$(s, i): " & secOut & " sec" & sCrLf
  770.     
  771.     sInput = sTest
  772.     ProfileStart sec
  773.     For i = 1 To cIter
  774.         For iPos = 1 To Len(sInput) - 1
  775.             sOut = Mid(sInput, iPos)
  776.         Next
  777.     Next
  778.     ProfileStop sec, secOut
  779.     sMsg = sMsg & "s = Mid(s, i): " & secOut & " sec" & sCrLf
  780.  
  781.     vInput = sTest
  782.     ProfileStart sec
  783.     For i = 1 To cIter
  784.         For iPos = 1 To Len(sInput) - 1
  785.             sOut = Mid(vInput, iPos)
  786.         Next
  787.     Next
  788.     ProfileStop sec, secOut
  789.     sMsg = sMsg & "s = Mid(v, i): " & secOut & " sec" & sCrLf
  790.  
  791.     vInput = sTest
  792.     ProfileStart sec
  793.     For i = 1 To cIter
  794.         For iPos = 1 To Len(sInput) - 1
  795.             vOut = Mid(vInput, iPos)
  796.         Next
  797.     Next
  798.     ProfileStop sec, secOut
  799.     sMsg = sMsg & "v = Mid(v, i): " & secOut & " sec" & sCrLf
  800.     
  801.     sInput = sTest
  802.     ProfileStart sec
  803.     For i = 1 To cIter
  804.         For iPos = 1 To Len(sInput) - 1
  805.             vOut = Mid(sInput, iPos)
  806.         Next
  807.     Next
  808.     ProfileStop sec, secOut
  809.     sMsg = sMsg & "v = Mid(s, i): " & secOut & " sec" & sCrLf
  810.     
  811.     DollarVsNone = sMsg
  812.  
  813. End Function
  814.  
  815. Function EmptyVsQuotes(cIter As Long) As String
  816.     Dim sec As Currency, secOut As Currency
  817.     Dim sMsg As String
  818.     Dim asTest(0 To 1) As String
  819.     Dim f As Boolean, i As Long
  820.     
  821.     asTest(0) = "Test"
  822.     asTest(1) = Empty
  823.     
  824.     ProfileStart sec
  825.     For i = 1 To cIter
  826.         f = (asTest(i Mod 2) = sEmpty)
  827.     Next
  828.     ProfileStop sec, secOut
  829.     sMsg = sMsg & "s = sEmpty (String constant): " & secOut & " sec" & sCrLf
  830.  
  831.     ProfileStart sec
  832.     For i = 1 To cIter
  833.         f = (asTest(i Mod 2) = "")
  834.     Next
  835.     ProfileStop sec, secOut
  836.     sMsg = sMsg & "s = """" (inline quotes): " & secOut & " sec" & sCrLf
  837.  
  838.     ProfileStart sec
  839.     For i = 1 To cIter
  840.         f = (asTest(i Mod 2) = Empty)
  841.     Next
  842.     ProfileStop sec, secOut
  843.     sMsg = sMsg & "s = Empty (Variant constant): " & secOut & " sec" & sCrLf
  844.  
  845.     ProfileStart sec
  846.     For i = 1 To cIter
  847.         f = (asTest(i Mod 2) = vbNullString)
  848.     Next
  849.     ProfileStop sec, secOut
  850.     sMsg = sMsg & "s = vbNullString (null pointer constant): " & secOut & " sec" & sCrLf
  851.  
  852.     EmptyVsQuotes = sMsg
  853.  
  854. End Function
  855.  
  856. Function WithWithout(cIter As Long) As String
  857.     Dim sec As Currency, secOut As Currency
  858.     Dim sMsg As String
  859.     Dim i As Long, iTest As Integer
  860.     Dim nc As CNull, rnc As CNull
  861.     Set nc = New CNull
  862.     
  863.     ProfileStart sec
  864.     For i = 1 To cIter
  865.         nc.ProcProp = 5
  866.         iTest = nc.ProcProp
  867.     Next
  868.     ProfileStop sec, secOut
  869.     sMsg = sMsg & "Qualified access, one read/write: " & secOut & " sec" & sCrLf
  870.     
  871.     ProfileStart sec
  872.     For i = 1 To cIter
  873.         With nc
  874.             .ProcProp = 5
  875.             iTest = .ProcProp
  876.         End With
  877.     Next
  878.     ProfileStop sec, secOut
  879.     sMsg = sMsg & "With access, one read/write: " & secOut & " sec" & sCrLf
  880.     
  881.     ProfileStart sec
  882.     For i = 1 To cIter
  883.         nc.ProcProp = 5
  884.         iTest = nc.ProcProp
  885.         nc.ProcProp = 6
  886.         iTest = nc.ProcProp
  887.     Next
  888.     ProfileStop sec, secOut
  889.     sMsg = sMsg & "Qualified access, two read/write: " & secOut & " sec" & sCrLf
  890.  
  891.     ProfileStart sec
  892.     For i = 1 To cIter
  893.         With nc
  894.             .ProcProp = 5
  895.             iTest = .ProcProp
  896.             .ProcProp = 6
  897.             iTest = .ProcProp
  898.         End With
  899.     Next
  900.     ProfileStop sec, secOut
  901.     sMsg = sMsg & "With access, two read/write: " & secOut & " sec" & sCrLf
  902.     
  903.     ProfileStart sec
  904.     For i = 1 To cIter
  905.         nc.ProcProp = 5
  906.         iTest = nc.ProcProp
  907.         nc.ProcProp = 6
  908.         iTest = nc.ProcProp
  909.         nc.ProcProp = 7
  910.         iTest = nc.ProcProp
  911.     Next
  912.     ProfileStop sec, secOut
  913.     sMsg = sMsg & "Qualified access, three read/write: " & secOut & " sec" & sCrLf
  914.  
  915.     ProfileStart sec
  916.     For i = 1 To cIter
  917.         With nc
  918.             .ProcProp = 5
  919.             iTest = .ProcProp
  920.             .ProcProp = 6
  921.             iTest = .ProcProp
  922.             .ProcProp = 7
  923.             iTest = .ProcProp
  924.         End With
  925.     Next
  926.     ProfileStop sec, secOut
  927.     sMsg = sMsg & "With access, three read/write: " & secOut & " sec" & sCrLf
  928.     
  929.     ProfileStart sec
  930.     For i = 1 To cIter
  931.         nc.ProcProp = 5
  932.         iTest = nc.ProcProp
  933.         nc.ProcProp = 6
  934.         iTest = nc.ProcProp
  935.         nc.ProcProp = 7
  936.         iTest = nc.ProcProp
  937.         nc.ProcProp = 8
  938.         iTest = nc.ProcProp
  939.     Next
  940.     ProfileStop sec, secOut
  941.     sMsg = sMsg & "Qualified access, four read/write: " & secOut & " sec" & sCrLf
  942.  
  943.     ProfileStart sec
  944.     For i = 1 To cIter
  945.         With nc
  946.             .ProcProp = 5
  947.             iTest = .ProcProp
  948.             .ProcProp = 6
  949.             iTest = .ProcProp
  950.             .ProcProp = 7
  951.             iTest = .ProcProp
  952.             .ProcProp = 8
  953.             iTest = .ProcProp
  954.         End With
  955.     Next
  956.     ProfileStop sec, secOut
  957.     sMsg = sMsg & "With access, four read/write: " & secOut & " sec" & sCrLf
  958.     
  959.     WithWithout = sMsg
  960.  
  961. End Function
  962.  
  963. Function MethodVsProc(cIter As Long) As String
  964.     Dim sec As Currency, secOut As Currency
  965.     Dim sMsg As String
  966.     Dim i As Long
  967.     Dim iTest As Integer
  968.     Dim nul As CNull, nulNew As New CNull, nulLate As Object
  969.     
  970.     Set nul = New CNull
  971.     Set nulLate = New CNull
  972.     
  973.     ProfileStart sec
  974.     For i = 1 To cIter
  975.         iTest = nul.FuncMethod()
  976.     Next
  977.     ProfileStop sec, secOut
  978.     sMsg = sMsg & "Call method function on object: " & secOut & " sec" & sCrLf
  979.     
  980.     ProfileStart sec
  981.     For i = 1 To cIter
  982.         iTest = nulNew.FuncMethod()
  983.     Next
  984.     ProfileStop sec, secOut
  985.     sMsg = sMsg & "Call method function on New object: " & secOut & " sec" & sCrLf
  986.  
  987.     ProfileStart sec
  988.     For i = 1 To cIter
  989.         iTest = nulLate.FuncMethod()
  990.     Next
  991.     ProfileStop sec, secOut
  992.     sMsg = sMsg & "Call method function on late-bound object: " & secOut & " sec" & sCrLf
  993.     
  994.     ProfileStart sec
  995.     For i = 1 To cIter
  996.         iTest = FuncProc()
  997.     Next
  998.     ProfileStop sec, secOut
  999.     sMsg = sMsg & "Call private function: " & secOut & " sec" & sCrLf
  1000.     
  1001.     ProfileStart sec
  1002.     For i = 1 To cIter
  1003.         nul.SubMethod iTest
  1004.     Next
  1005.     ProfileStop sec, secOut
  1006.     sMsg = sMsg & "Pass variable to method sub on object: " & secOut & " sec" & sCrLf
  1007.  
  1008.     ProfileStart sec
  1009.     For i = 1 To cIter
  1010.         nulNew.SubMethod iTest
  1011.     Next
  1012.     ProfileStop sec, secOut
  1013.     sMsg = sMsg & "Pass variable to method sub on New object: " & secOut & " sec" & sCrLf
  1014.  
  1015.     ProfileStart sec
  1016.     For i = 1 To cIter
  1017.         nulLate.SubMethod iTest
  1018.     Next
  1019.     ProfileStop sec, secOut
  1020.     sMsg = sMsg & "Pass variable to method sub on late-bound object: " & secOut & " sec" & sCrLf
  1021.  
  1022.     ProfileStart sec
  1023.     For i = 1 To cIter
  1024.         iTest = FuncProc()
  1025.     Next
  1026.     ProfileStop sec, secOut
  1027.     sMsg = sMsg & "Pass variable to private sub: " & secOut & " sec" & sCrLf
  1028.     
  1029.     ProfileStart sec
  1030.     For i = 1 To cIter
  1031.         nul.ProcProp = 5
  1032.     Next
  1033.     ProfileStop sec, secOut
  1034.     sMsg = sMsg & "Assign through property let on object: " & secOut & " sec" & sCrLf
  1035.  
  1036.     ProfileStart sec
  1037.     For i = 1 To cIter
  1038.         nulNew.ProcProp = 5
  1039.     Next
  1040.     ProfileStop sec, secOut
  1041.     sMsg = sMsg & "Assign through property let on New object: " & secOut & " sec" & sCrLf
  1042.  
  1043.     ProfileStart sec
  1044.     For i = 1 To cIter
  1045.         nulLate.ProcProp = 5
  1046.     Next
  1047.     ProfileStop sec, secOut
  1048.     sMsg = sMsg & "Assign through property let on late-bound object: " & secOut & " sec" & sCrLf
  1049.     
  1050.     ProfileStart sec
  1051.     For i = 1 To cIter
  1052.         PrivProp = 5
  1053.     Next
  1054.     ProfileStop sec, secOut
  1055.     sMsg = sMsg & "Assign through private property let: " & secOut & " sec" & sCrLf
  1056.     
  1057.     ProfileStart sec
  1058.     For i = 1 To cIter
  1059.         iTest = nul.ProcProp
  1060.     Next
  1061.     ProfileStop sec, secOut
  1062.     sMsg = sMsg & "Assign from property get on object: " & secOut & " sec" & sCrLf
  1063.  
  1064.     ProfileStart sec
  1065.     For i = 1 To cIter
  1066.         iTest = nulNew.ProcProp
  1067.     Next
  1068.     ProfileStop sec, secOut
  1069.     sMsg = sMsg & "Assign from property get on New object: " & secOut & " sec" & sCrLf
  1070.  
  1071.     ProfileStart sec
  1072.     For i = 1 To cIter
  1073.         iTest = nulLate.ProcProp
  1074.     Next
  1075.     ProfileStop sec, secOut
  1076.     sMsg = sMsg & "Assign from property get on late-bound object: " & secOut & " sec" & sCrLf
  1077.  
  1078.     ProfileStart sec
  1079.     For i = 1 To cIter
  1080.         iTest = PrivProp
  1081.     Next
  1082.     ProfileStop sec, secOut
  1083.     sMsg = sMsg & "Assign from private property get: " & secOut & " sec" & sCrLf
  1084.     
  1085.     ProfileStart sec
  1086.     For i = 1 To cIter
  1087.         nul.PubProp = 5
  1088.     Next
  1089.     ProfileStop sec, secOut
  1090.     sMsg = sMsg & "Assign to public property on object: " & secOut & " sec" & sCrLf
  1091.  
  1092.     ProfileStart sec
  1093.     For i = 1 To cIter
  1094.         nulNew.PubProp = 5
  1095.     Next
  1096.     ProfileStop sec, secOut
  1097.     sMsg = sMsg & "Assign to public property on New object: " & secOut & " sec" & sCrLf
  1098.  
  1099.     ProfileStart sec
  1100.     For i = 1 To cIter
  1101.         nulLate.PubProp = 5
  1102.     Next
  1103.     ProfileStop sec, secOut
  1104.     sMsg = sMsg & "Assign to public property on late-bound object: " & secOut & " sec" & sCrLf
  1105.  
  1106.     ProfileStart sec
  1107.     For i = 1 To cIter
  1108.         iVar = 5
  1109.     Next
  1110.     ProfileStop sec, secOut
  1111.     sMsg = sMsg & "Assign to private variable: " & secOut & " sec" & sCrLf
  1112.     
  1113.     ProfileStart sec
  1114.     For i = 1 To cIter
  1115.         iTest = nul.PubProp
  1116.     Next
  1117.     ProfileStop sec, secOut
  1118.     sMsg = sMsg & "Assign from public property on object: " & secOut & " sec" & sCrLf
  1119.  
  1120.     ProfileStart sec
  1121.     For i = 1 To cIter
  1122.         iTest = nulNew.PubProp
  1123.     Next
  1124.     ProfileStop sec, secOut
  1125.     sMsg = sMsg & "Assign from public property on New object: " & secOut & " sec" & sCrLf
  1126.  
  1127.     ProfileStart sec
  1128.     For i = 1 To cIter
  1129.         iTest = nulLate.PubProp
  1130.     Next
  1131.     ProfileStop sec, secOut
  1132.     sMsg = sMsg & "Assign from public property on late-bound object: " & secOut & " sec" & sCrLf
  1133.  
  1134.     ProfileStart sec
  1135.     For i = 1 To cIter
  1136.         iTest = iVar
  1137.     Next
  1138.     ProfileStop sec, secOut
  1139.     sMsg = sMsg & "Assign from private variable: " & secOut & " sec" & sCrLf
  1140.     
  1141.     MethodVsProc = sMsg
  1142.  
  1143. End Function
  1144.  
  1145. Private Sub SubProc(i As Integer)
  1146.     i = 1
  1147. End Sub
  1148.  
  1149. Private Function FuncProc()
  1150.     FuncProc = 2
  1151. End Function
  1152.  
  1153. Private Property Let PrivProp(i As Integer)
  1154.     iVar = i
  1155. End Property
  1156.  
  1157. Private Property Get PrivProp() As Integer
  1158.     PrivProp = iVar
  1159. End Property
  1160.  
  1161. Function ForEachVsForI(cIter As Long) As String
  1162.     Dim sec As Currency, secOut As Currency
  1163.     Dim sMsg As String, i As Long, nul As CNull
  1164.     Dim iTemp As Integer, s As String, v As Variant, ix As Integer
  1165.     Dim iMax As Long
  1166.  
  1167.     iMax = cIter
  1168.     cIter = 1
  1169.     
  1170.     Dim avNull() As Variant
  1171.     Dim aiNull() As Integer
  1172.     Dim asNull() As String
  1173.     Dim anulNull() As CNull
  1174.     ReDim avNull(1 To iMax) As Variant
  1175.     ReDim aiNull(1 To iMax) As Integer
  1176.     ReDim asNull(1 To iMax) As String
  1177.     ReDim anulNull(1 To iMax) As CNull
  1178.     Dim nNull As Collection
  1179.     Set nNull = New Collection
  1180.     Dim vecNull As CVector
  1181.     Set vecNull = New CVector
  1182.     Dim veciNull As CVectorInt
  1183.     Set veciNull = New CVectorInt
  1184.     Dim lstNull As New CList
  1185.     Set lstNull = New CList
  1186.     Dim walker As CListWalker
  1187.     Set walker = New CListWalker
  1188.     
  1189.     ' Create collection, arrays, vector, and list of iMax Integers
  1190.     For iTemp = 1 To iMax
  1191.         avNull(iTemp) = iTemp
  1192.         aiNull(iTemp) = iTemp
  1193.         nNull.Add iTemp
  1194.         vecNull(iTemp) = iTemp
  1195.         veciNull(iTemp) = iTemp
  1196.         lstNull.Add iTemp
  1197.     Next
  1198.     
  1199.     ProfileStart sec
  1200.     For i = 1 To cIter
  1201.         For iTemp = 1 To iMax
  1202.             ix = avNull(iTemp)
  1203.         Next
  1204.     Next
  1205.     ProfileStop sec, secOut
  1206.     sMsg = sMsg & "For I on Variant Integer array: " & secOut & " sec" & sCrLf
  1207.  
  1208.     ProfileStart sec
  1209.     For i = 1 To cIter
  1210.         For Each v In avNull
  1211.             ix = v
  1212.         Next
  1213.     Next
  1214.     ProfileStop sec, secOut
  1215.     sMsg = sMsg & "For Each on Variant Integer array: " & secOut & " sec" & sCrLf
  1216.  
  1217.     ProfileStart sec
  1218.     For i = 1 To cIter
  1219.         For iTemp = 1 To iMax
  1220.             ix = aiNull(iTemp)
  1221.         Next
  1222.     Next
  1223.     ProfileStop sec, secOut
  1224.     sMsg = sMsg & "For I on Integer array: " & secOut & " sec" & sCrLf
  1225.  
  1226.     ProfileStart sec
  1227.     For i = 1 To cIter
  1228.         For Each v In aiNull
  1229.             ix = v
  1230.         Next
  1231.     Next
  1232.     ProfileStop sec, secOut
  1233.     sMsg = sMsg & "For Each on Integer array: " & secOut & " sec" & sCrLf
  1234.  
  1235.     ProfileStart sec
  1236.     For i = 1 To cIter
  1237.         For iTemp = 1 To nNull.Count
  1238.             ix = nNull(iTemp)
  1239.         Next
  1240.     Next
  1241.     ProfileStop sec, secOut
  1242.     sMsg = sMsg & "For I on Integer collection: " & secOut & " sec" & sCrLf
  1243.     
  1244.     ProfileStart sec
  1245.     For i = 1 To cIter
  1246.         For Each v In nNull
  1247.             ix = v
  1248.         Next
  1249.     Next
  1250.     ProfileStop sec, secOut
  1251.     sMsg = sMsg & "For Each on Integer collection: " & secOut & " sec" & sCrLf
  1252.  
  1253.     ProfileStart sec
  1254.     For i = 1 To cIter
  1255.         For iTemp = 1 To vecNull.Last
  1256.             ix = vecNull(iTemp)
  1257.         Next
  1258.     Next
  1259.     ProfileStop sec, secOut
  1260.     sMsg = sMsg & "For I on Variant Integer vector: " & secOut & " sec" & sCrLf
  1261.     
  1262.     ProfileStart sec
  1263.     For i = 1 To cIter
  1264.         For Each v In vecNull
  1265.             ix = v
  1266.         Next
  1267.     Next
  1268.     ProfileStop sec, secOut
  1269.     sMsg = sMsg & "For Each on Variant Integer vector: " & secOut & " sec" & sCrLf
  1270.  
  1271.     ProfileStart sec
  1272.     For i = 1 To cIter
  1273.         For iTemp = 1 To veciNull.Last
  1274.             ix = veciNull(iTemp)
  1275.         Next
  1276.     Next
  1277.     ProfileStop sec, secOut
  1278.     sMsg = sMsg & "For I on Integer vector: " & secOut & " sec" & sCrLf
  1279.     
  1280.     ProfileStart sec
  1281.     For i = 1 To cIter
  1282.         For Each v In veciNull
  1283.             ix = v
  1284.         Next
  1285.     Next
  1286.     ProfileStop sec, secOut
  1287.     sMsg = sMsg & "For Each on Integer vector: " & secOut & " sec" & sCrLf
  1288.  
  1289.     ProfileStart sec
  1290.     For i = 1 To cIter
  1291.         For iTemp = 1 To lstNull.Count
  1292.             ix = lstNull(iTemp)
  1293.         Next
  1294.     Next
  1295.     ProfileStop sec, secOut
  1296.     sMsg = sMsg & "For I on Integer list: " & secOut & " sec" & sCrLf
  1297.     
  1298.     ProfileStart sec
  1299.     For i = 1 To cIter
  1300.         For Each v In lstNull
  1301.             ix = v
  1302.         Next
  1303.     Next
  1304.     ProfileStop sec, secOut
  1305.     sMsg = sMsg & "For Each on Integer list: " & secOut & " sec" & sCrLf
  1306.  
  1307.     ProfileStart sec
  1308.     For i = 1 To cIter
  1309.         walker.Attach lstNull
  1310.         Do While walker.More
  1311.             ix = walker
  1312.         Loop
  1313.     Next
  1314.     ProfileStop sec, secOut
  1315.     sMsg = sMsg & "Do While on Integer list: " & secOut & " sec" & sCrLf
  1316.  
  1317. #If 0 Then  ' Turned out to be uninteresting, but left for the curious
  1318.     ' Create a collection and an array of iMax strings
  1319.     Set nNull = Nothing
  1320.     Set nNull = New Collection
  1321.     vecNull.Last = vecNull.Chunk
  1322.     lstNull.Clear
  1323.     For iTemp = 1 To iMax
  1324.         avNull(iTemp) = "Item" & iTemp
  1325.         asNull(iTemp) = "Item" & iTemp
  1326.         nNull.Add "Item" & iTemp
  1327.         vecNull(i) = "Item" & iTemp
  1328.         lstNull.Add "Item" & iTemp
  1329.     Next
  1330.     
  1331.     ProfileStart sec
  1332.     For i = 1 To cIter
  1333.         For iTemp = 1 To iMax
  1334.             s = avNull(iTemp)
  1335.         Next
  1336.     Next
  1337.     ProfileStop sec, secOut
  1338.     sMsg = sMsg & "For I on Variant String array: " & secOut & " sec" & sCrLf
  1339.  
  1340.     ProfileStart sec
  1341.     For i = 1 To cIter
  1342.         For Each v In avNull
  1343.             s = v
  1344.         Next
  1345.     Next
  1346.     ProfileStop sec, secOut
  1347.     sMsg = sMsg & "For Each on Variant String array: " & secOut & " sec" & sCrLf
  1348.  
  1349.     ProfileStart sec
  1350.     For i = 1 To cIter
  1351.         For iTemp = 1 To iMax
  1352.             s = asNull(iTemp)
  1353.         Next
  1354.     Next
  1355.     ProfileStop sec, secOut
  1356.     sMsg = sMsg & "For I on String array: " & secOut & " sec" & sCrLf
  1357.  
  1358.     ProfileStart sec
  1359.     For i = 1 To cIter
  1360.         For Each v In asNull
  1361.             s = v
  1362.         Next
  1363.     Next
  1364.     ProfileStop sec, secOut
  1365.     sMsg = sMsg & "For Each on String array: " & secOut & " sec" & sCrLf
  1366.  
  1367.     ProfileStart sec
  1368.     For i = 1 To cIter
  1369.         For iTemp = 1 To nNull.Count
  1370.             s = nNull(iTemp)
  1371.         Next
  1372.     Next
  1373.     ProfileStop sec, secOut
  1374.     sMsg = sMsg & "For I on String collection: " & secOut & " sec" & sCrLf
  1375.     
  1376.     ProfileStart sec
  1377.     For i = 1 To cIter
  1378.         For Each v In nNull
  1379.             s = v
  1380.         Next
  1381.     Next
  1382.     ProfileStop sec, secOut
  1383.     sMsg = sMsg & "For Each on String collection: " & secOut & " sec" & sCrLf
  1384.  
  1385.     ProfileStart sec
  1386.     For i = 1 To cIter
  1387.         For iTemp = 1 To vecNull.Last
  1388.             s = vecNull(iTemp)
  1389.         Next
  1390.     Next
  1391.     ProfileStop sec, secOut
  1392.     sMsg = sMsg & "For I on String vector: " & secOut & " sec" & sCrLf
  1393.     
  1394.     ProfileStart sec
  1395.     For i = 1 To cIter
  1396.         For Each v In vecNull
  1397.             s = v
  1398.         Next
  1399.     Next
  1400.     ProfileStop sec, secOut
  1401.     sMsg = sMsg & "For Each on String vector: " & secOut & " sec" & sCrLf
  1402.  
  1403.     ProfileStart sec
  1404.     For i = 1 To cIter
  1405.         For iTemp = 1 To lstNull.Count
  1406.             s = lstNull(iTemp)
  1407.         Next
  1408.     Next
  1409.     ProfileStop sec, secOut
  1410.     sMsg = sMsg & "For I on String list: " & secOut & " sec" & sCrLf
  1411.     
  1412.     ProfileStart sec
  1413.     For i = 1 To cIter
  1414.         For Each v In lstNull
  1415.             s = v
  1416.         Next
  1417.     Next
  1418.     ProfileStop sec, secOut
  1419.     sMsg = sMsg & "For Each on String list: " & secOut & " sec" & sCrLf
  1420.  
  1421.     ProfileStart sec
  1422.     For i = 1 To cIter
  1423.         walker.Attach lstNull
  1424.         Do While walker.More
  1425.             s = walker
  1426.         Loop
  1427.     Next
  1428.     ProfileStop sec, secOut
  1429.     sMsg = sMsg & "Do While on String list: " & secOut & " sec" & sCrLf
  1430. #End If
  1431.  
  1432.     ' Create a collection and an array of iMax objects
  1433.     Set nNull = Nothing
  1434.     Set nNull = New Collection
  1435.     vecNull.Last = vecNull.Chunk
  1436.     lstNull.Clear
  1437.     For iTemp = 1 To iMax
  1438.         Set nul = New CNull
  1439.         nul.PubProp = iTemp
  1440.         Set anulNull(iTemp) = nul
  1441.         Set avNull(iTemp) = nul
  1442.         Set anulNull(iTemp) = nul
  1443.         nNull.Add nul
  1444.         Set vecNull(iTemp) = nul
  1445.         lstNull.Add nul
  1446.     Next
  1447.     
  1448.     ProfileStart sec
  1449.     For i = 1 To cIter
  1450.         For iTemp = 1 To iMax
  1451.             ix = avNull(iTemp).PubProp
  1452.         Next
  1453.     Next
  1454.     ProfileStop sec, secOut
  1455.     sMsg = sMsg & "For I on Variant object array: " & secOut & " sec" & sCrLf
  1456.     
  1457.     ProfileStart sec
  1458.     For i = 1 To cIter
  1459.         For Each v In avNull
  1460.             ix = v.PubProp
  1461.         Next
  1462.     Next
  1463.     ProfileStop sec, secOut
  1464.     sMsg = sMsg & "For Each on Variant object array: " & secOut & " sec" & sCrLf
  1465.     
  1466.     ProfileStart sec
  1467.     For i = 1 To cIter
  1468.         For iTemp = 1 To iMax
  1469.             ix = anulNull(iTemp).PubProp
  1470.         Next
  1471.     Next
  1472.     ProfileStop sec, secOut
  1473.     sMsg = sMsg & "For I on object array: " & secOut & " sec" & sCrLf
  1474.     
  1475.     ProfileStart sec
  1476.     For i = 1 To cIter
  1477.         For Each v In anulNull
  1478.             ix = v.PubProp
  1479.         Next
  1480.     Next
  1481.     ProfileStop sec, secOut
  1482.     sMsg = sMsg & "For Each on object array: " & secOut & " sec" & sCrLf
  1483.     
  1484.     ProfileStart sec
  1485.     For i = 1 To cIter
  1486.         For iTemp = 1 To nNull.Count
  1487.             ix = nNull(iTemp).PubProp
  1488.         Next
  1489.     Next
  1490.     ProfileStop sec, secOut
  1491.     sMsg = sMsg & "For I on object collection: " & secOut & " sec" & sCrLf
  1492.     
  1493.     ProfileStart sec
  1494.     For i = 1 To cIter
  1495.         For Each nul In nNull
  1496.             ix = nul.PubProp
  1497.         Next
  1498.     Next
  1499.     ProfileStop sec, secOut
  1500.     sMsg = sMsg & "For Each on object collection: " & secOut & " sec" & sCrLf
  1501.  
  1502.     ProfileStart sec
  1503.     For i = 1 To cIter
  1504.         For iTemp = 1 To vecNull.Last
  1505.             ix = vecNull(iTemp).PubProp
  1506.         Next
  1507.     Next
  1508.     ProfileStop sec, secOut
  1509.     sMsg = sMsg & "For I on object vector: " & secOut & " sec" & sCrLf
  1510.     
  1511.     ProfileStart sec
  1512.     For i = 1 To cIter
  1513.         For Each nul In vecNull
  1514.             ix = nul.PubProp
  1515.         Next
  1516.     Next
  1517.     ProfileStop sec, secOut
  1518.     sMsg = sMsg & "For Each on object vector: " & secOut & " sec" & sCrLf
  1519.  
  1520.     ProfileStart sec
  1521.     For i = 1 To cIter
  1522.         For iTemp = 1 To lstNull.Count
  1523.             ix = lstNull(iTemp).PubProp
  1524.         Next
  1525.     Next
  1526.     ProfileStop sec, secOut
  1527.     sMsg = sMsg & "For I on object list: " & secOut & " sec" & sCrLf
  1528.     
  1529.     ProfileStart sec
  1530.     For i = 1 To cIter
  1531.         For Each nul In lstNull
  1532.             ix = nul.PubProp
  1533.         Next
  1534.     Next
  1535.     ProfileStop sec, secOut
  1536.     sMsg = sMsg & "For Each on object list: " & secOut & " sec" & sCrLf
  1537.  
  1538.     ProfileStart sec
  1539.     For i = 1 To cIter
  1540.         walker.Attach lstNull
  1541.         Do While walker.More
  1542.             ix = walker.Item.PubProp
  1543.         Loop
  1544.     Next
  1545.     ProfileStop sec, secOut
  1546.     sMsg = sMsg & "Do While on object list: " & secOut & " sec" & sCrLf
  1547.     
  1548.     ForEachVsForI = sMsg
  1549.  
  1550. End Function
  1551.  
  1552. Function SortCollectVsArray(cIter As Long) As String
  1553. ' Uncomment to step through and verify that everything works
  1554. '#Const fTestSorts = 1
  1555. #If fTestSorts Then
  1556.     cIter = 10
  1557. #End If
  1558.     Dim sec As Currency, secOut As Currency
  1559.     Dim sMsg As String
  1560.     Dim i As Long, iTemp As Long, c As Integer
  1561.     Dim av() As Variant
  1562.     Dim n As New Collection
  1563.     c = cIter
  1564.     ReDim av(1 To cIter) As Variant
  1565.  
  1566.     ProfileStart sec
  1567.     For i = 1 To c
  1568.         av(i) = i
  1569.     Next
  1570.     ProfileStop sec, secOut
  1571.     sMsg = sMsg & "Fill array: " & secOut & " sec" & sCrLf
  1572.     
  1573.     ProfileStart sec
  1574.     For i = 1 To c
  1575.         n.Add i
  1576.     Next
  1577.     ProfileStop sec, secOut
  1578.     sMsg = sMsg & "Fill collection: " & secOut & " sec" & sCrLf
  1579.     ShowNA av(), n
  1580.  
  1581.     ProfileStart sec
  1582.     ShuffleArray av()
  1583.     ProfileStop sec, secOut
  1584.     sMsg = sMsg & "Shuffle array: " & secOut & " sec" & sCrLf
  1585.  
  1586.     ProfileStart sec
  1587.     ShuffleCollection n
  1588.     ProfileStop sec, secOut
  1589.     sMsg = sMsg & "Shuffle collection: " & secOut & " sec" & sCrLf
  1590.     ShowNA av(), n
  1591.  
  1592.     ProfileStart sec
  1593.     SortArray av(), 1, c
  1594.     ProfileStop sec, secOut
  1595.     sMsg = sMsg & "Sort array: " & secOut & " sec" & sCrLf
  1596.  
  1597.     ProfileStart sec
  1598.     SortCollection n, 1, c
  1599.     ProfileStop sec, secOut
  1600.     sMsg = sMsg & "Sort collection: " & secOut & " sec" & sCrLf
  1601.     ShowNA av(), n
  1602.  
  1603.     Dim v As Variant, iPos As Long, f As Boolean
  1604.     v = Random(1, c)
  1605.     ProfileStart sec
  1606.     For i = 1 To 50
  1607.         f = BSearchArray(av(), v, iPos)
  1608.     Next
  1609.     ProfileStop sec, secOut
  1610.     sMsg = sMsg & "Search array 50 Times: " & secOut & " sec" & sCrLf
  1611. #If fTestSorts Then
  1612.     BugMessage "Array element " & v & IIf(f, sEmpty, "not ") & " found at " & iPos
  1613. #End If
  1614.  
  1615.     ProfileStart sec
  1616.     For i = 1 To 50
  1617.         f = BSearchCollection(n, v, iPos)
  1618.     Next
  1619.     ProfileStop sec, secOut
  1620.     sMsg = sMsg & "Search collection 50 Times: " & secOut & " sec" & sCrLf
  1621. #If fTestSorts Then
  1622.     BugMessage "Collection element " & v & IIf(f, sEmpty, "not ") & " found at " & iPos
  1623. #End If
  1624.  
  1625.     SortCollectVsArray = sMsg
  1626.  
  1627. End Function
  1628.  
  1629. #If fTestSorts Then
  1630. Sub ShowNA(av() As Variant, n As Collection)
  1631.     Dim s As String, i As Integer, v As Variant
  1632.     For i = LBound(av) To UBound(av)
  1633.         s = s & av(i) & " "
  1634.     Next
  1635.     BugMessage "Array: " & s & sCrLf
  1636.     s = sEmpty
  1637.     For Each v In n
  1638.         s = s & v & " "
  1639.     Next
  1640.     BugMessage "Collection: " & s & sCrLf
  1641. End Sub
  1642. #Else
  1643. Sub ShowNA(av() As Variant, n As Collection)
  1644. End Sub
  1645. #End If
  1646.  
  1647. Function AddCollect(cIter As Long) As String
  1648.     Dim sec As Currency, secOut As Currency
  1649.     Dim sMsg As String
  1650.     Dim i As Long, iTemp As Long, cHalf As Long
  1651.     Dim n As Collection
  1652.     cHalf = cIter / 2
  1653.     
  1654.     Set n = New Collection
  1655.     ProfileStart sec
  1656.     For i = 1 To cHalf
  1657.         n.Add i
  1658.     Next
  1659.     ProfileStop sec, secOut
  1660.     sMsg = sMsg & "Add first half to end of collection: " & secOut & " sec" & sCrLf
  1661.  
  1662.     ProfileStart sec
  1663.     For i = cHalf + 1 To cIter
  1664.         n.Add i
  1665.     Next
  1666.     ProfileStop sec, secOut
  1667.     sMsg = sMsg & "Add last half to end of collection: " & secOut & " sec" & sCrLf
  1668.     Set n = Nothing
  1669.  
  1670.     Set n = New Collection
  1671.     ProfileStart sec
  1672.     n.Add 1
  1673.     For i = 2 To cHalf
  1674.         n.Add i, , 1
  1675.     Next
  1676.     ProfileStop sec, secOut
  1677.     sMsg = sMsg & "Add first half to start of collection: " & secOut & " sec" & sCrLf
  1678.  
  1679.     ProfileStart sec
  1680.     For i = cHalf + 1 To cIter
  1681.         n.Add i, , 1
  1682.     Next
  1683.     ProfileStop sec, secOut
  1684.     sMsg = sMsg & "Add last half to start of collection: " & secOut & " sec" & sCrLf
  1685.     Set n = Nothing
  1686.  
  1687.     Set n = New Collection
  1688.     ProfileStart sec
  1689.     n.Add 1
  1690.     For i = 2 To cHalf
  1691.         n.Add i, , i \ 2
  1692.     Next
  1693.     ProfileStop sec, secOut
  1694.     sMsg = sMsg & "Add first half to middle of collection: " & secOut & " sec" & sCrLf
  1695.  
  1696.     ProfileStart sec
  1697.     For i = cHalf + 1 To cIter
  1698.         n.Add i, , i \ 2
  1699.     Next
  1700.     ProfileStop sec, secOut
  1701.     sMsg = sMsg & "Add last half to middle of collection: " & secOut & " sec" & sCrLf
  1702.     Set n = Nothing
  1703.  
  1704.     AddCollect = sMsg
  1705.  
  1706. End Function
  1707.  
  1708. Function SortRecurseVsIterate(cIter As Long) As String
  1709.     Dim sec As Currency, secOut As Currency
  1710.     Dim sMsg As String, i As Integer
  1711.     Dim aR() As Variant, ai() As Variant
  1712.     Dim helper As New CSortHelper
  1713.     
  1714.     ReDim aR(1 To cIter) As Variant
  1715.     ReDim ai(1 To cIter) As Variant
  1716.     esmMode = esmSortVal
  1717.  
  1718.     ' Fill all arrays
  1719.     For i = 1 To cIter
  1720.         aR(i) = i
  1721.         ai(i) = i
  1722.     Next
  1723.     
  1724.     ' Randomize with same random sequence for both
  1725.     Seed 33
  1726.     ShuffleArray aR(), helper
  1727.     Seed 33
  1728.     ShuffleArray ai(), helper
  1729.     
  1730.     ProfileStart sec
  1731.     SortArrayRec aR() ', helper, 1, CInt(c)
  1732.     ProfileStop sec, secOut
  1733.     sMsg = sMsg & "Sort recursively: " & secOut & " sec" & sCrLf
  1734.     
  1735.     ProfileStart sec
  1736.     SortArray ai() ', helper, 1, CInt(c)
  1737.     ProfileStop sec, secOut
  1738.     sMsg = sMsg & "Sort iteratively: " & secOut & " sec" & sCrLf
  1739.     
  1740.     SortRecurseVsIterate = sMsg
  1741.  
  1742. End Function
  1743.  
  1744. Function SortNameVsSortPoly(cIter As Long) As String
  1745.     Dim sec As Currency, secOut As Currency
  1746.     Dim sMsg As String, v As Variant
  1747.     Dim i As Long, iTemp As Long, c As Integer
  1748.     Dim aN() As Variant, aP() As Variant
  1749.     Dim helper As New CSortHelper
  1750.     
  1751.     On Error Resume Next
  1752.     
  1753.     c = cIter
  1754.     ReDim aN(1 To cIter) As Variant
  1755.     ReDim aP(1 To cIter) As Variant
  1756.     esmMode = esmSortVal
  1757.  
  1758.     ' Fill all arrays
  1759.     For i = 1 To c
  1760.         aN(i) = i
  1761.         aP(i) = i
  1762.     Next
  1763.     
  1764.     ' Use same random sequence for both
  1765.     Rnd -1
  1766.     ProfileStart sec
  1767.     ShuffleArrayO aN
  1768.     ProfileStop sec, secOut
  1769.     sMsg = sMsg & "Shuffle with name-space hack: " & secOut & " sec" & sCrLf
  1770.  
  1771.     Rnd -1
  1772.     ProfileStart sec
  1773.     ShuffleArray aP(), helper
  1774.     ProfileStop sec, secOut
  1775.     sMsg = sMsg & "Shuffle with polymorphic hack: " & secOut & " sec" & sCrLf
  1776.     
  1777.     ProfileStart sec
  1778.     SortArrayO aN(), 1, c
  1779.     ProfileStop sec, secOut
  1780.     sMsg = sMsg & "Sort with name-space hack: " & secOut & " sec" & sCrLf
  1781.  
  1782.     ProfileStart sec
  1783.     SortArray aP(), 1, c, helper
  1784.     ProfileStop sec, secOut
  1785.     sMsg = sMsg & "Sort with polymorphic hack: " & secOut & " sec" & sCrLf
  1786.         
  1787.     Dim iPos As Long, f As Boolean
  1788.     v = Random(1, c)
  1789.     ProfileStart sec
  1790.     For i = 1 To 50
  1791.         f = BSearchArrayO(aN(), v, iPos)
  1792.     Next
  1793.     ProfileStop sec, secOut
  1794.     sMsg = sMsg & "Search 50 times with name-space hack: " & secOut & " sec" & sCrLf
  1795.  
  1796.     v = Random(1, c)
  1797.     ProfileStart sec
  1798.     For i = 1 To 50
  1799.         f = BSearchArray(aP(), v, iPos, helper)
  1800.     Next
  1801.     ProfileStop sec, secOut
  1802.     sMsg = sMsg & "Search 50 times with polymorphic hack: " & secOut & " sec" & sCrLf
  1803.     
  1804.     SortNameVsSortPoly = sMsg
  1805.     
  1806. End Function
  1807.  
  1808. Function CompareFindFiles(cIter As Long) As String
  1809.     Dim sec As Currency, secOut As Currency
  1810.     Dim i As Long, sMsg As String, v As Variant
  1811.     Dim nFiles As Collection, vFile As Variant
  1812.     Dim sFind As String, sDir As String
  1813.     sFind = Environ$("COMSPEC")
  1814.     sDir = Left$(CurDir$, 3)
  1815.     ProfileStart sec
  1816.     For i = 1 To cIter
  1817.         Set nFiles = FindFilesDir(sFind, sDir)
  1818.     Next
  1819.     ProfileStop sec, secOut
  1820.     sMsg = sMsg & "Find files with Dir$: " & secOut & " sec" & sCrLf
  1821.     BugMessage "Files found by FindFilesDir: " & sCrLf
  1822.     For Each vFile In nFiles
  1823.         BugMessage vFile & sCrLf
  1824.     Next
  1825.  
  1826.     Set nFiles = Nothing
  1827.     ProfileStart sec
  1828.     For i = 1 To cIter
  1829.         Set nFiles = FindFiles(sFind, sDir)
  1830.     Next
  1831.     ProfileStop sec, secOut
  1832.     sMsg = sMsg & sCrLf & "Find files with FindFirstFile: " & secOut & " sec" & sCrLf
  1833.     BugMessage "Files found by FindFiles: " & sCrLf
  1834.     For Each vFile In nFiles
  1835.         BugMessage vFile & sCrLf
  1836.     Next
  1837.     CompareFindFiles = sMsg
  1838.     
  1839. End Function
  1840.  
  1841. Function DeclareVsTypeLib(cIter As Long) As String
  1842.     Dim sec As Currency, secOut As Currency
  1843.     Dim i As Long, dw As Long
  1844.     Dim sMsg As String
  1845.     
  1846.     ProfileStart sec
  1847.     For i = 1 To cIter
  1848.         dw = GetVersionTmp
  1849.     Next
  1850.     ProfileStop sec, secOut
  1851.     sMsg = sMsg & "Call Declare function: " & secOut & " sec" & sCrLf
  1852.     
  1853.     ProfileStart sec
  1854.     For i = 1 To cIter
  1855.         dw = GetVersion
  1856.     Next
  1857.     ProfileStop sec, secOut
  1858.     sMsg = sMsg & "Call type library function: " & secOut & " sec" & sCrLf
  1859.     DeclareVsTypeLib = sMsg
  1860.     
  1861. End Function
  1862.  
  1863. Function CompareExistFile(cIter As Long) As String
  1864.     Dim sec As Currency, secOut As Currency
  1865.     Dim i As Long, f As Boolean, sMsg As String
  1866.     
  1867.     ProfileStart sec
  1868.     For i = 1 To cIter
  1869.         f = ExistFile(Environ$("COMSPEC"))
  1870.     Next
  1871.     ProfileStop sec, secOut
  1872.     sMsg = sMsg & "ExistFile (error trap) on file: " & secOut & " sec" & sCrLf
  1873.     
  1874.     ProfileStart sec
  1875.     For i = 1 To cIter
  1876.         f = ExistFile(Left$(CurDir$, 3) & "\autofool.bat")
  1877.     Next
  1878.     ProfileStop sec, secOut
  1879.     sMsg = sMsg & "ExistFile (error trap) on no file: " & secOut & " sec" & sCrLf
  1880.     
  1881.     ProfileStart sec
  1882.     For i = 1 To cIter
  1883.         f = ExistFileDir(Environ$("COMSPEC"))
  1884.     Next
  1885.     ProfileStop sec, secOut
  1886.     sMsg = sMsg & "ExistFileDir (API) on file: " & secOut & " sec" & sCrLf
  1887.     
  1888.     ProfileStart sec
  1889.     For i = 1 To cIter
  1890.         f = ExistFileDir(Left$(CurDir$, 3) & "\autofool.bat")
  1891.     Next
  1892.     ProfileStop sec, secOut
  1893.     sMsg = sMsg & "ExistFileDir (API) on no file: " & secOut & " sec" & sCrLf
  1894.     
  1895.     ProfileStart sec
  1896.     For i = 1 To cIter
  1897.         f = Exists(Environ$("COMSPEC"))
  1898.     Next
  1899.     ProfileStop sec, secOut
  1900.     sMsg = sMsg & "Exists (Dir$) on file: " & secOut & " sec" & sCrLf
  1901.     
  1902.     ProfileStart sec
  1903.     For i = 1 To cIter
  1904.         f = Exists(Left$(CurDir$, 3) & "\autofool.bat")
  1905.     Next
  1906.     ProfileStop sec, secOut
  1907.     sMsg = sMsg & "Exists (Dir$) on no file: " & secOut & " sec" & sCrLf
  1908.     
  1909.     CompareExistFile = sMsg
  1910.     
  1911. End Function
  1912.  
  1913. Function CompareFriendVsPublic(cIter As Long) As String
  1914.     Dim sec As Currency, secOut As Currency
  1915.     Dim i As Long, dw As Long
  1916.     Dim sMsg As String
  1917.     Dim fvp As CNull
  1918.     
  1919.     Set fvp = New CNull
  1920.     
  1921.     ProfileStart sec
  1922.     For i = 1 To cIter
  1923.         dw = fvp.FriendProp
  1924.     Next
  1925.     ProfileStop sec, secOut
  1926.     sMsg = sMsg & "Call Friend property on class: " & secOut & " sec" & sCrLf
  1927.     
  1928.     ProfileStart sec
  1929.     For i = 1 To cIter
  1930.         dw = fvp.ProcProp
  1931.     Next
  1932.     ProfileStop sec, secOut
  1933.     sMsg = sMsg & "Call Public property on class: " & secOut & " sec" & sCrLf
  1934.     
  1935.     ProfileStart sec
  1936.     For i = 1 To cIter
  1937.         dw = FTimeIt.FriendProp
  1938.     Next
  1939.     ProfileStop sec, secOut
  1940.     sMsg = sMsg & "Call Friend property on form: " & secOut & " sec" & sCrLf
  1941.     
  1942.     ProfileStart sec
  1943.     For i = 1 To cIter
  1944.         dw = FTimeIt.ProcProp
  1945.     Next
  1946.     ProfileStop sec, secOut
  1947.     sMsg = sMsg & "Call Public property on form: " & secOut & " sec" & sCrLf
  1948.     CompareFriendVsPublic = sMsg
  1949.     
  1950. End Function
  1951.  
  1952. ' Efficient find files function
  1953. Function FindFiles(sTarget As String, _
  1954.                    Optional ByVal Start As String) As Collection
  1955.  
  1956.     ' Statics for less memory use in recursive procedure
  1957.     Static sName As String, sSpec As String, nFound As New Collection
  1958.     Static fd As WIN32_FIND_DATA, iLevel As Long
  1959.     Dim hFiles As Long, f As Boolean
  1960.     If Start = sEmpty Then Start = CurDir$
  1961.     ' Maintain level to ensure collection is cleared first time
  1962.     If iLevel = 0 Then
  1963.         Set nFound = Nothing
  1964.         Start = NormalizePath(Start)
  1965.     End If
  1966.     iLevel = iLevel + 1
  1967.     
  1968.     ' Find first file (get handle to find)
  1969.     hFiles = FindFirstFile(Start & "*.*", fd)
  1970.     f = (hFiles <> INVALID_HANDLE_VALUE)
  1971.     Do While f
  1972.         sName = ByteZToStr(fd.cFileName)
  1973.         ' Skip . and ..
  1974.         If Left$(sName, 1) <> "." Then
  1975.             sSpec = Start & sName
  1976.             If fd.dwFileAttributes And vbDirectory Then
  1977.                 DoEvents
  1978.                 ' Call recursively on each directory
  1979.                 FindFiles sTarget, sSpec & "\"
  1980.             ElseIf StrComp(sName, sTarget, 1) = 0 Then ' Text comparison
  1981.                 ' Store found files in collection
  1982.                 nFound.Add sSpec
  1983.             End If
  1984.         End If
  1985.         ' Keep looping until no more files
  1986.         f = FindNextFile(hFiles, fd)
  1987.     Loop
  1988.     f = FindClose(hFiles)
  1989.     ' Return the matching files in collection
  1990.     Set FindFiles = nFound
  1991.     iLevel = iLevel - 1
  1992. End Function
  1993.  
  1994. ' Inefficient find files function to show how bad Dir$ is
  1995. Function FindFilesDir(sTarget As String, _
  1996.                       Optional ByVal Start As String) As Collection
  1997.  
  1998.     ' Statics for less memory use in recursive procedure
  1999.     Static sName As String, sSpec As String, v As Variant
  2000.     Static nFound As New Collection, iLevel As Long
  2001.     Dim nDirNames As New Collection
  2002.     If Start = sEmpty Then Start = CurDir$
  2003.     If iLevel = 0 Then
  2004.         Set nFound = Nothing
  2005.         Start = NormalizePath(Start)
  2006.     End If
  2007.     iLevel = iLevel + 1
  2008.     
  2009.     ' Ignore errors so that VB invalid file name won't kill search
  2010.     ' (Basic fails on weird but legal Win32 names such as ??????)
  2011.     On Error Resume Next
  2012.     ' Get first file
  2013.     sName = Dir$(Start, vbDirectory)
  2014.     Do While sName <> sEmpty
  2015.         ' Skip . and ..
  2016.         If Left$(sName, 1) <> "." Then
  2017.             sSpec = Start & sName
  2018.             If GetAttr(sSpec) And vbDirectory Then
  2019.                 ' Cache directory names in collection
  2020.                 nDirNames.Add sName
  2021.             ElseIf StrComp(sName, sTarget, 1) = 0 Then ' Text comparison
  2022.                 ' Store found files in collection
  2023.                 nFound.Add sSpec
  2024.             End If
  2025.         End If
  2026.         ' Keep looping until no more files
  2027.         sName = Dir$()
  2028.     Loop
  2029.  
  2030.     ' Call recursively on each cached directory
  2031.     For Each v In nDirNames
  2032.         FindFilesDir sTarget, Start & v & "\"
  2033.     Next
  2034.  
  2035.     ' Return the count of matching files
  2036.     Set FindFilesDir = nFound
  2037.     iLevel = iLevel - 1
  2038.  
  2039. End Function
  2040.